home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d12 / v10n12.arc / ISKIND.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-30  |  3KB  |  105 lines
  1. PROGRAM iskind;
  2. TYPE
  3.   Pt = ^base;
  4.   GrandAP = ^GrandA;
  5.   GrandBP = ^GrandB;
  6.  
  7.   base = object
  8.     CONSTRUCTOR Init;
  9.     DESTRUCTOR Done;
  10.     FUNCTION IsKindOf(T:Pointer):boolean; virtual;
  11.     FUNCTION IsA:pointer;
  12.   END;
  13.  
  14.   ChildA = object(base)
  15.     CONSTRUCTOR Init;
  16.     FUNCTION IsKindOf(T:Pointer):boolean; virtual;
  17.     PROCEDURE WhoAreYou; virtual;
  18.   END;
  19.  
  20.   ChildB = object(base)
  21.     CONSTRUCTOR Init;
  22.     FUNCTION IsKindOf(T:Pointer):boolean; virtual;
  23.   END;
  24.  
  25.   GrandA = object(ChildA)
  26.     CONSTRUCTOR Init;
  27.     FUNCTION IsKindOf(T:Pointer):boolean; virtual;
  28.     PROCEDURE WhoAreYou; virtual;
  29.   END;
  30.  
  31.   GrandB = object(ChildB)
  32.     CONSTRUCTOR Init;
  33.     FUNCTION IsKindOf(T:Pointer):boolean; virtual;
  34.   END;
  35.  
  36. (**** All the constructors and the destructor: ***)
  37.   DESTRUCTOR Base.Done; BEGIN END;
  38.  
  39.   CONSTRUCTOR Base.Init; BEGIN END;
  40.   CONSTRUCTOR ChildA.Init; BEGIN END;
  41.   CONSTRUCTOR ChildB.Init; BEGIN END;
  42.   CONSTRUCTOR GrandA.Init; BEGIN END;
  43.   CONSTRUCTOR GrandB.Init; BEGIN END;
  44.  
  45. (**** The IsA method, used by all objects in the hierarchy: ****)
  46.   FUNCTION base.IsA:pointer; BEGIN IsA:= TypeOf(self); END;
  47.  
  48. (**** All the IsKindOf methods: ****)
  49.   FUNCTION base.IsKindOf(T:Pointer):boolean;
  50.   BEGIN IsKindOf := (T=TypeOf(base)); END;
  51.  
  52.   FUNCTION ChildA.IsKindOf(T:Pointer):boolean;
  53.   BEGIN IsKindOf := (T=TypeOf(ChildA)) OR base.IsKindOf(T); END;
  54.  
  55.   FUNCTION ChildB.IsKindOf(T:Pointer):boolean;
  56.   BEGIN IsKindOf := (T=TypeOf(ChildB)) OR base.IsKindOf(T); END;
  57.  
  58.   FUNCTION GrandA.IsKindOf(T:Pointer):boolean;
  59.   BEGIN IsKindOf := (T=TypeOf(GrandA)) OR ChildA.IsKindOf(T); END;
  60.  
  61.   FUNCTION GrandB.IsKindOf(T:Pointer):boolean;
  62.   BEGIN IsKindOf := (T=TypeOf(GrandB)) OR ChildB.IsKindOf(T); END;
  63.  
  64. (**** WhoAreYou methods, for the objects that have them: ***)
  65.   PROCEDURE ChildA.WhoAreYou; BEGIN WriteLn('I am a ChildA'); END;
  66.  
  67.   PROCEDURE GrandA.WhoAreYou; BEGIN WriteLn('I am a GrandA'); END;
  68.  
  69.   PROCEDURE Test(B1:Base; VAR B2 : base);
  70.   BEGIN
  71.     Write('The variable passed by reference SEEMS to be a ');
  72.     IF B1.IsA = TypeOf(base) THEN WriteLn('base type');
  73.     IF B1.IsA = TypeOf(ChildA) THEN WriteLn('ChildA type');
  74.     IF B1.IsA = TypeOf(GrandA) THEN WriteLn('GrandA type');
  75.     Write('The variable passed by value is a ');
  76.     IF B2.IsA = TypeOf(base) THEN WriteLn('base type');
  77.     IF B2.IsA = TypeOf(ChildA) THEN WriteLn('ChildA type');
  78.     IF B2.IsA = TypeOf(GrandA) THEN WriteLn('GrandA type');
  79.   END;
  80.  
  81. VAR P : Pt;
  82. BEGIN
  83.   P := New(GrandAP, Init);
  84.   Test(P^, P^);
  85.  
  86.   If P^.IsKindOf(TypeOf(ChildA)) THEN
  87.     BEGIN
  88.       Write('The object says --> ');
  89.       ChildA(P^).WhoAreYou;
  90.     END
  91.   ELSE WriteLn('The object does not have a "WhoAreYou" method.');
  92.   Dispose(P,done);
  93.  
  94.   P := New(GrandBP, Init);
  95.   If P^.IsKindOf(TypeOf(ChildA)) THEN
  96.     BEGIN
  97.       Write('The object says --> ');
  98.       ChildA(P^).WhoAreYou;
  99.     END
  100.   ELSE WriteLn('The object does not have a "WhoAreYou" method.');
  101.   Dispose(P,done);
  102.  
  103.   (* ChildA(P^).WhoAreYou;} *)(*This line will crash your system*)
  104. END.
  105.